home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 5: The Fifth Dimension / 17 Bit - The Fifth Dimension (1995)(17 Bit Software)[!].iso / files / 3416.dms / 3416.adf / ARexx / PrintPedigree.rexx < prev    next >
OS/2 REXX Batch file  |  1994-05-21  |  17KB  |  650 lines
  1. /****************************************************************************
  2.  *                                                                          *
  3.  * $VER: PrintPedigree 1.10 (1 Mar 1994)
  4.  *                                                                          *
  5.  *                      Written by Freddy Ariës                             *
  6.  *                                                                          *
  7.  * Output options:                                                          *
  8.  *  1. Pedigree Chart - male ancestor line only [Dutch: stamreeks]          *
  9.  *  2. Pedigree Chart - all ancestors, no siblings [Dutch: kwartierstaat]   *
  10.  *  3. Pedigree Chart - all ancestors, only siblings of last generation     *
  11.  *  4. Pedigree Chart - all ancestors, all siblings                         *
  12.  *                                                                          *
  13.  * This version uses (by default) the rexxreqtools.library (which requires  *
  14.  * a version of reqtools larger than 2.0 and rexxsyslib.library)            *
  15.  * If you do not have any of these, you need to supply the NOREQ argument,  *
  16.  * except when you supply the QUIET argument.                               *
  17.  *                                                                          *
  18.  * TO DO:                                                                   *
  19.  *  - count the number of lines output and give a formfeed after a certain  *
  20.  *    number (ie. skip page breaks)                                         *
  21.  *  - Add a menu option for the maximum number of generations to print      *
  22.  *  - allow user to specify if he wants burial data printed, occupation,    *
  23.  *    comments, references fields, ....                                     *
  24.  *                                                                          *
  25.  ****************************************************************************/
  26.  
  27. options results
  28. arg prtin prsirn outname noirn mgen outval
  29.  
  30. versionstr = "1.10"
  31. usereq = 1; /* change this to 0 if you don't want to use reqtools */
  32. outp = 1; useirn = 1; prtdev = stdout
  33. plwidth = 78;  /* linewidth of the printer */
  34. NL = '0A'x
  35.  
  36. signal on IOERR
  37.  
  38. /* parse command line options, to allow calling the script automatically,
  39.  * eg. from a function key
  40.  */
  41.  
  42. do while prtin = '?'
  43.   Tell("NUMOPT/A/N,PERSONIRN/A/N,OUTFILE/A,NOIRN/S,MAXGEN/N,QUIET/S,NOREQ/S: ")
  44.   pull prtin prsirn outname noirn mgen outval
  45. end
  46.  
  47. ParseArguments()
  48.  
  49. if usereq & ~show('l','rexxreqtools.library') then do
  50.   if exists('libs:rexxreqtools.library') then
  51.     call addlib('rexxreqtools.library',0,-30,0)
  52.   else do
  53.     usereq = 0; outp = 1
  54.     Tell("Unable to open rexxreqtools.library - using text output")
  55.   end
  56. end
  57.  
  58. /* These first few lines were stolen from Peter Billings - thanks Peter ;-) */
  59. if ~show('P','SCIONGEN') then do
  60.   TermError('I am sorry to say that the SCION Genealogist' || NL ||,
  61.     'database is not available. Please start the' || NL ||,
  62.     'SCION program BEFORE using this script!')
  63. end
  64.  
  65. myport = "SCIONGEN"
  66. address value myport
  67. GETDBNAME
  68. dbname = upper(RESULT)
  69.  
  70. if outp & ~usereq then do
  71.   Tell("*** PrintPedigree version "||versionstr||" ***")
  72.   Tell("***       by Freddy Ariës      ***")
  73.   Tell("Current database: "||dbname||NL)
  74. end
  75. if prtopt = 0 then do
  76.   /* No use in asking for input if we're not allowed to output anything */
  77.   if usereq then do
  78.     prtopt = rtezrequest('Current Scion database: '||dbname||NL||,
  79.       NL||'Please make your choice: '||,
  80.       NL||'1. Pedigree Chart - male ancestor line only'||,
  81.       NL||'2. Pedigree Chart - all ancestors, no siblings'||,
  82.       NL||'3. Pedigree Chart - all ancestors, only last generation siblings'||,
  83.       NL||'4. Pedigree Chart - all ancestors, all siblings'||,
  84.       '',' _1 | _2 | _3 | _4 |E_xit','PrintPedigree v'||versionstr||' by Freddy Ariës')
  85.     if prtopt = 0 then
  86.       EXIT
  87.  
  88.     irn = rtgetlong(,'Enter the IRN of the person whose'||,
  89.             NL||'ancestors you want to print: '||,
  90.             NL,'Input Request:','_Continue')
  91.     irn = abs(irn)
  92.     useirn = rtezrequest('Do you want to output the IRNs'||,
  93.               NL||'(the record numbers) as well?'||,
  94.               '',' _Yes| _No ','Input Request:')
  95.   end
  96.   else do
  97.     Tell("1. Pedigree Chart - male ancestor line only")
  98.     Tell("2. Pedigree Chart - all ancestors, no siblings")
  99.     Tell("3. Pedigree Chart - all ancestors, only siblings of last generation")
  100.     Tell("4. Pedigree Chart - all ancestors, all siblings")
  101.     TellNN("Your choice: ")
  102.     pull prtopt
  103.     prtopt = CheckAnswer(prtopt)
  104.  
  105.     TellNN("Enter the IRN of the person whose ancestors you want to print: ")
  106.     pull irn
  107.  
  108.     TellNN("Do you want to output the IRN (numbers) as well (y/n)? ")
  109.     pull instr
  110.     Tell("")
  111.     if left(instr, 1) = "Y" then useirn = 1
  112.     else useirn = 0
  113.   end
  114. end
  115.  
  116. irn = CheckIRN(irn)
  117.  
  118. EXISTPERSON irn
  119. if RESULT ~= 'YES' then
  120.   TermError("No person with IRN "||irn||" in the current database.")
  121.  
  122. if outp then do
  123.   pname = GetNameStr(irn, 0)
  124.   if usereq then do
  125.     valcont = rtezrequest('The selected person is: '||NL||pname||'.'||,
  126.       NL||'Continue?','_Continue| _Abort','PrintPedigree Request:')
  127.     if valcont = 0 then
  128.       EXIT
  129.   end
  130.   else do
  131.     TellNN("Current person is "||pname||". Continue? (y/n) ")
  132.     pull valcont
  133.     if left(valcont, 1) ~= 'Y' then
  134.       TermError("Ok.")
  135.   end
  136. end
  137.  
  138. if outp & outname = "" then do
  139.   if usereq then do
  140.     odev = rtezrequest('Current Scion database: '||dbname||,
  141.       NL||'Where should the output be sent to?'||,
  142.       NL,' _File |_Printer|_Screen|_Nowhere','PrintPedigree v'||versionstr||' by Freddy Ariës')
  143.     select
  144.       when odev = 1 then do
  145.         /* We need a file requester for further data */
  146.         dblen = length(dbname)
  147.         if dblen>6 & right(dbname, 6)=".SCION" then
  148.           dbname=left(dbname, dblen - 6)
  149.         outname = rtfilerequest('RAM:',dbname||'.PED','Output filename')
  150.         if outname = '' then
  151.           outname = dbname||'.PED'
  152.       end
  153.       when odev = 2 then
  154.         outname = 'PRT:'
  155.       when odev = 3 then
  156.         outname = 'STDOUT'
  157.       otherwise
  158.         EXIT
  159.         /* You selected 'Nowhere' */
  160.     end
  161.   end
  162.   else do
  163.     Tell("Enter output file (filename with complete path, or PRT: for printer,")
  164.     TellNN("or STDOUT for screen): ")
  165.     pull outname
  166.     if outname = "" then
  167.       outname = "STDOUT"
  168.   end
  169. end
  170.  
  171. if instr = "" then do
  172. end
  173.  
  174. /* Anyone know a better way to translate numbers into Roman? */
  175. GenerationS.1 = "I II III IV V VI VII VIII IX X XI XII XIII XIV XV XVI XVII XVIII XIX XX"
  176. GenerationS.2 = "XXI XXII XXIII XXIV XXV XXVI XXVII XXVIII XXIX XXX XXXI XXXII XXXIII XXXIV XXXV XXXVI XXXVII XXXVIII IXL XL"
  177.  
  178. /* Printer Codes (some of which are currently unused): */
  179. ESC = '1B'x
  180. prtinit = ESC||"#1";     /* ESC#1 initialize      */
  181. prtundon = ESC||"[4m";   /* ESC[4m underline on   */
  182. prtundoff = ESC||"[24m"; /* ESC[24m underline off */
  183. prtdson = ESC||"[1m";    /* ESC[1m boldface on    */
  184. prtdsoff = ESC||"[22m";  /* ESC[22m boldface off  */
  185. prtnlqon = ESC||"[2"||'22'x||"z";  /* ESC[2"z NLQ on  */
  186. prtnlqoff = ESC||"[1"||'22'x||"z"; /* ESC[1"z NLQ off */
  187.  
  188. if ~usereq then
  189.   Tell("Building ancestor table...")
  190.  
  191. currgen = 1
  192. numpers = 1
  193. GENTREE.1 = irn
  194.  
  195. /* Build the ancestor table */
  196. do until ~foundone
  197.   foundone = 0
  198.   currgen = currgen + 1
  199.   numpers = 2 * numpers
  200.   /* = 2 ** (currgen - 1) */
  201.   if currgen <= MaxGens then
  202.   do
  203.     /* no use to build the entire table, if we need only this little */
  204.     if prtopt = 1 then
  205.       endnum = numpers+1
  206.     else
  207.       endnum = 2*numpers-1
  208.     do ct = numpers to endnum by 2
  209.       ct1 = ct % 2
  210.       irn = GENTREE.ct1
  211.       ct1 = ct + 1
  212.       GENTREE.ct = 0
  213.       GENTREE.ct1 = 0
  214.       if irn ~= 0 then do
  215.         GETPARENTS irn
  216.         fgrn = RESULT
  217.         EXISTFAMILY fgrn
  218.         if RESULT = 'YES' then do
  219.           foundone = 1
  220.           GetParentsIRN(fgrn, ct, ct1)
  221.         end
  222.       end
  223.     end
  224.   end
  225. end
  226. numgens = currgen - 1
  227.  
  228. /* Now print all the ancestors */
  229. if ~usereq then
  230.   Tell("Printing data...")
  231.  
  232. OpenPrinter()
  233.  
  234. if prtopt = 1 then do
  235.   /* print only male ancestors */
  236.   fill = 7
  237.   np = numpers%2
  238.   currgen = 1
  239.   do while np > 1
  240.     g1 = GetGenStr(currgen, fill)
  241.     ct1 = np + 1
  242.     ct2 = ct % 2
  243.     /* get the husband's data */
  244.     g1 = g1||GetPersonStr(GENTREE.np)
  245.     m1 = GetMarriageStr(GENTREE.ct2)
  246.     if m1 ~= "" then
  247.       m1 = g1||", m: "||m1
  248.     else m1 = g1
  249.     g1 = copies(' ',fill)
  250.     PrintLines(m1, fill)
  251.     /* get the wife's data */
  252.     m1 = g1||GetPersonStr(GENTREE.ct1)
  253.     PrintLines(m1, fill)
  254.     PrintLF()  
  255.     currgen = currgen + 1
  256.     np = np % 2
  257.   end
  258.   g1 = GetGenStr(currgen, fill)||GetPersonStr(GENTREE.np)
  259.   g1 = g1||GetMarriages(GENTREE.np)
  260.   PrintLines(g1, fill)
  261.   PrintLF()  
  262. end
  263. else do
  264.   /* print all */
  265.   currgen = currgen - 1
  266.   fill = 6
  267.  
  268.   g1 = center("Generation: "||GetGenStr(currgen, fill), plwidth-1)
  269.   PrintLines(g1, fill)
  270.   g1 = "1.    "||GetPersonStr(GENTREE.1)
  271.   g1 = g1||GetMarriages(GENTREE.1)
  272.   PrintLines(g1, fill)
  273.   if prtopt > 2 then
  274.     PrintSiblings(GENTREE.1, 1)
  275.   PrintLF()  
  276.  
  277.   np = 2
  278.   currgen = currgen - 1
  279.   do while np < numpers
  280.     g1 = center("Generation: "||GetGenStr(currgen, fill), plwidth)
  281.     PrintLines(g1, fill)
  282.     endnum = 2*np-1
  283.     do ct = np to endnum by 2
  284.       ct1 = ct + 1
  285.       ct2 = ct % 2
  286.       /* print the principal data */
  287.       if GENTREE.ct ~= 0 then do
  288.         g1 = left(ct||".    ",fill)||GetPersonStr(GENTREE.ct)
  289.         m1 = GetMarriageStr(GENTREE.ct2)
  290.         if m1 ~= "" then
  291.           m1 = g1||", m: "||m1
  292.         else m1 = g1
  293.         g1 = copies(' ',fill)
  294.         PrintLines(m1, fill)
  295.         if prtopt = 4 then
  296.           PrintSiblings(GENTREE.ct, ct)
  297.       end
  298.       /* print the spouse data */
  299.       if GENTREE.ct1 ~= 0 then do
  300.         m1 = left(ct1||".    ",fill)||GetPersonStr(GENTREE.ct1)
  301.         PrintLines(m1, fill)
  302.         if prtopt = 4 then
  303.           PrintSiblings(GENTREE.ct1, ct1)
  304.       end
  305.     end
  306.     PrintLF()  
  307.     currgen = currgen - 1
  308.     np = np * 2
  309.   end
  310. end
  311. if numgens = 1 then
  312.   PrintLines("No ancestors are recorded for this person.", 0)
  313.  
  314. if usereq then
  315.   rtezrequest('Output ready.','E_xit','PrintPedigree Message:')
  316. else
  317.   Tell("Done.")
  318.  
  319. writeln(prtdev, prtnlqoff); /* ESC[1"z NLQ off */
  320. close(prtdev)
  321. EXIT
  322.  
  323. /* Parse command line arguments and set the appropriate global variables */
  324. ParseArguments:
  325. if noirn = "NOIRN" then useirn = 0
  326. else if noirn = "QUIET" || noirn = "NOREQ" then do
  327.   outval = noirn
  328.   noirn = ""
  329. end
  330. else do
  331.   outval = mgen
  332.   mgen = noirn
  333.   noirn = ""
  334. end
  335. if mgen = "QUIET" || mgen = "NOREQ" then do
  336.   outval = mgen
  337.   mgen = ""
  338. end
  339.  
  340. MaxGens = 40; /* due to the Roman numbers, we can't handle more */
  341. if mgen ~= "" then do
  342.   if DATATYPE(mgen, 'w') & mgen > 0 & mgen < MaxGens then
  343.     MaxGens = mgen
  344. end
  345.  
  346. if outval = "QUIET" then do
  347.   outp = 0
  348.   domenu = 0
  349. end
  350. else if outval = "NOREQ" then
  351.   usereq = 0
  352.  
  353. if outname = "" then
  354.   outname = "STDOUT"
  355.  
  356. if prtin = "" | prsirn = "" then do
  357.   prtopt = 0
  358.   if ~outp then TermError("Requires argument is missing.")
  359.     /* actually, with outp = 0, all it does is EXIT */
  360. end
  361. else do
  362.   prtopt = CheckAnswer(prtin)
  363.   irn = CheckIRN(prsirn)
  364.   /* Note that it was important to establish outp before calling these */
  365. end  
  366.  
  367. return 0
  368.  
  369. OpenPrinter:
  370. /* Open the printer device and print out a nice header */
  371. if outname = "STDOUT" then
  372.   prtdev = stdout
  373. else do
  374.   prtdev = 'PRINTER'
  375.   if ~open(prtdev, outname, 'w') then
  376.     TermError("ERROR: Failed to open output file!")
  377. end
  378. writeln(prtdev, prtinit||prtnlqon)
  379. if prtopt = 1 then
  380.   prtstr = "PEDIGREE CHART - MALE ANCESTOR LINE ONLY"
  381. else if prtopt = 2 then
  382.   prtstr = "PEDIGREE CHART - ALL ANCESTORS, NO SIBLINGS"
  383. else if prtopt = 3 then
  384.   prtstr = "PEDIGREE CHART - ALL ANCESTORS, ONLY SIBLINGS OF LAST GENERATION"
  385. else
  386.   prtstr = "PEDIGREE CHART - ALL ANCESTORS, ALL SIBLINGS"
  387. prtstr = prtundon||prtdson||prtstr||prtdsoff||prtundoff
  388. writeln(prtdev, prtstr)
  389. prtstr = prtdson||"Report printed on: "||date()||prtdsoff
  390. writeln(prtdev, prtstr)
  391. prtstr = copies('=', plwidth)
  392. writeln(prtdev, prtstr)
  393. return 0
  394.  
  395. PrintLines: PROCEDURE EXPOSE prtdev plwidth prtopt
  396. parse arg ostr, fill
  397. /* TO DO:
  398.  * if there are control strings within ostr (like prtdson or prtdsoff)
  399.  * don't include them in the length count
  400.  */
  401. do while ostr ~= ""
  402.   nnl = plwidth+1
  403.   if length(ostr) > plwidth then do
  404.     do until pc = ' ' | nnl = 1
  405.       pc = substr(ostr, nnl, 1)
  406.       nnl = nnl - 1
  407.     end
  408.     if nnl = 1 then do
  409.       prtstr = left(ostr, plwidth)
  410.       ostr = delstr(ostr, 1, nnl)
  411.     end
  412.     else do
  413.       prtstr = left(ostr, nnl)
  414.       ostr = delstr(ostr, 1, nnl+1)
  415.     end
  416.   end
  417.   else do
  418.     prtstr = ostr
  419.     ostr = ""
  420.   end
  421.   writeln(prtdev, prtstr)
  422.   if ostr ~= "" then
  423.     ostr = copies(' ',fill)||ostr
  424. end
  425. return 0
  426.  
  427. PrintLF:
  428. writeln(prtdev, "")
  429. return 0
  430.  
  431. PrintSiblings: PROCEDURE EXPOSE prtdev plwidth prtopt useirn
  432. parse arg inum, prenum
  433. GETPARENTS inum
  434. famfgrn = RESULT
  435. EXISTFAMILY famfgrn
  436. if RESULT ~= 'YES' then return 0; /* no parents, then no siblings */
  437. ix = 0; chnum = 0
  438. do until ischld ~= 'YES'
  439.   GETCHILD famfgrn ix
  440.   prsn = RESULT
  441.   EXISTPERSON prsn
  442.   ischld = RESULT
  443.   if ischld = 'YES' & prsn ~= inum then do
  444.     chnum = chnum + 1
  445.     ostr = copies(' ',6)||prenum||D2C(chnum+96)". "||GetPersonStr(prsn)
  446.     PrintLines(ostr, 10)
  447.     if chnum = 26 then return 0; /* Can't handle more than 26 children */
  448.   end
  449.   ix = ix + 1
  450. end
  451. return 0
  452.  
  453. GetGenStr: PROCEDURE EXPOSE prtopt GenerationS.
  454. parse arg gnum, fill
  455. if gnum <= 20 then
  456.   gstr = word(GenerationS.1, gnum)
  457. else if gnum <= 40 then
  458.   gstr = word(GenerationS.2, gnum)
  459. else
  460.   return ""
  461. if prtopt = 1 then gstr = left(gstr||".     ",fill)
  462. return gstr
  463.  
  464. GetPersonStr: PROCEDURE EXPOSE useirn
  465. parse arg irn
  466. if irn ~= 0 then do
  467.   nstr = GetNameStr(irn)
  468.   nstr = nstr||GetBirthStr(irn)
  469.   nstr = nstr||GetDeathStr(irn)
  470. end
  471. else
  472.   nstr = "UNKNOWN"
  473. return nstr
  474.  
  475. GetNameStr: PROCEDURE EXPOSE useirn
  476. parse arg gnum
  477. /* prtdson = '1B'x||"[1m";    * ESC[1m boldface on    */
  478. /* prtdsoff = '1B'x||"[22m";  * ESC[22m boldface off  */
  479. GETFIRSTNAME gnum
  480. name = RESULT
  481. if name ~= "" then name = name||" "
  482. GETLASTNAME gnum
  483. lname = RESULT
  484. if lname = "" then lname = "UNKNOWN"
  485. name = name||lname
  486. /* another option: name = name||prtdson||lname||prtdsoff
  487.  * Problem: see PrintLines
  488.  */
  489. if useirn then name = name||" ["gnum"]"
  490. return name
  491.  
  492. GetBirthStr: PROCEDURE
  493. parse arg gnum
  494. GETBIRTHPLACE gnum
  495. bstr = RESULT
  496. GETBIRTHDATE gnum
  497. bdat = RESULT
  498. if bdat ~= "" & bstr ~= "" then bstr = bstr||" "
  499. bstr = bstr||bdat
  500. if bstr ~= "" then bstr = ", b: "||bstr
  501. return bstr
  502.  
  503. GetDeathStr: PROCEDURE
  504. parse arg gnum
  505. GETDEATHPLACE gnum
  506. dstr = RESULT
  507. GETDEATHDATE gnum
  508. ddat = RESULT
  509. if ddat ~= "" & dstr ~= "" then dstr = dstr||" "
  510. dstr = dstr||ddat
  511. if dstr ~= "" then dstr = ", d: "||dstr
  512. return dstr
  513.  
  514. GetMarriages: PROCEDURE EXPOSE useirn
  515. parse arg irn
  516. mstr = ""
  517. GETMARRIAGE irn 0
  518. mf = RESULT
  519. EXISTFAMILY mf
  520. if RESULT = 'YES' then do
  521.   mtrue = 1
  522.   GETMARRIAGE irn 1
  523.   m2 = RESULT
  524.   EXISTFAMILY m2
  525.   if RESULT = 'YES' then mset = 1
  526.   else mset = 0
  527. end
  528. else
  529.   mtrue = 0  
  530. mnum = 0
  531. do while mtrue
  532.   m1 = GetMarriageStr(mf)
  533.   if m1 ~= "" then m1  = m1||' '
  534.   ptn = GetPartnerIRN(mf, irn)
  535.   m1 = m1||GetPersonStr(ptn)
  536.  
  537.   if mset then mstr = ", m("||mnum||"): "||m1
  538.   else mstr = ", m: "||m1
  539.  
  540.   mnum = mnum + 1    
  541.   GETMARRIAGE irn mnum
  542.   mf = RESULT
  543.   EXISTFAMILY mf
  544.   if RESULT ~= 'YES' then mtrue = 0
  545. end
  546. return mstr
  547.  
  548. GetMarriageStr: PROCEDURE
  549. parse arg mf
  550. GETMARRYPLACE mf
  551. mstr = RESULT
  552. GETMARRYDATE mf
  553. mdat = RESULT
  554. if mdat ~= "" & mstr ~= "" then mstr = mstr||" "
  555. mstr = mstr||mdat
  556. return mstr
  557.  
  558. GetParentsIRN: PROCEDURE EXPOSE GENTREE.
  559. parse arg fnum, ct, ct1
  560. fath = 0; moth = 0
  561. GETSPOUSE fnum
  562. sps = RESULT
  563. EXISTPERSON sps
  564. if RESULT = 'YES' then do
  565.   GETSEX sps
  566.   if RESULT = 'M' then
  567.     fath = sps
  568.   else moth = sps
  569. end
  570. GETPRINCIPAL fnum
  571. prn = RESULT
  572. /* If there are two mothers, or two fathers, then name the principal
  573.  * as 'father' and the spouse as 'mother' (don't worry, we're not
  574.  * changing their gender!
  575.  */
  576. EXISTPERSON prn
  577. if RESULT = 'YES' then do
  578.   GETSEX prn
  579.   if RESULT = 'M' then do
  580.     if fath ~= 0 then
  581.       moth = sps
  582.     fath = prn
  583.   end
  584.   else if moth ~= 0 then
  585.     fath = prn
  586.   else
  587.     moth = prn
  588. end
  589. GENTREE.ct = fath
  590. GENTREE.ct1 = moth
  591. return 0
  592.  
  593. GetPartnerIRN: PROCEDURE
  594. parse arg fnum, inum
  595. GETPRINCIPAL fnum
  596. prn = RESULT
  597. GETSPOUSE fnum
  598. sps = RESULT
  599. if inum = prn then pnum = sps
  600. else if inum = sps then pnum = prn
  601. else pnum = 0
  602. return pnum
  603.  
  604. CheckAnswer: PROCEDURE EXPOSE outp prtdev usereq
  605. parse arg str
  606. str = left(str, 1)
  607. if ~DATATYPE(str, 'w') then
  608.   TermError("Arg(1): not a valid option number.")
  609. if str < 1 | str > 4 then
  610.   TermError("Arg(1): not a valid option number.")
  611. return  str
  612.  
  613. CheckIRN: PROCEDURE EXPOSE outp prtdev usereq
  614. parse arg str
  615. if ~DATATYPE(str, 'w') then
  616.   TermError("Arg(2): not a valid IRN..")
  617. return str
  618.  
  619. Tell: PROCEDURE EXPOSE outp
  620. parse arg str
  621. if outp then
  622.   writeln(stdout, str)
  623. return 0
  624.  
  625. TellNN: PROCEDURE EXPOSE outp
  626. /* Tell, No Newline */
  627. parse arg str
  628. if outp then
  629.   writech(stdout, str)
  630. return 0
  631.  
  632. TermError: PROCEDURE EXPOSE outp prtdev usereq
  633. parse arg str
  634. /* If you turned off stdout, no error messages will be shown! */
  635. if usereq then
  636.   rtezrequest(str,'E_xit','PrintDescendant Message:')
  637. else do
  638.   Tell(str || '0A'x)
  639. end
  640. close(prtdev)
  641. EXIT
  642.  
  643. /* Let's make sure you get a nice message when you turn off the printer :-) */
  644.  
  645. IOERR:
  646.   bline = SIGL
  647.   say "I/O error #"||RC||" detected in line "||bline||":"
  648.   say sourceline(bline)
  649.   EXIT
  650.